home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d2
/
sysid47.arc
/
SYSID.INC
< prev
next >
Wrap
Text File
|
1989-12-17
|
60KB
|
2,641 lines
(*
** SYSID.INC
**
** Version 4.7
**
** The functions and procedures for SYSID.PAS
**
** Steve Grant
** Long Beach, CA
** July 31, 1989
*)
procedure caption1(a : string);
begin
textcolor(lightgray);
write(a);
textcolor(lightgreen)
end;
procedure caption2(a : string);
const
capterm = ': ';
var
i : byte;
begin
i := length(a);
while (i > 0) and (a[i] = ' ') do
dec(i);
insert(capterm, a, i + 1);
caption1(a)
end;
function nocarry : boolean;
begin
nocarry := regs.flags and fcarry = $0000
end;
function hex(a : word; b : byte) : string;
const
digit : array[$0..$F] of char = '0123456789ABCDEF';
var
i : byte;
xstring : string;
begin
xstring := '';
for i := 1 to b do begin
insert(digit[a and $000F], xstring, 1);
a := a shr 4
end;
hex := xstring
end;
procedure unknown(a : string; b : word; c : byte);
begin
writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
end;
procedure caption3(a : string);
begin
caption2(' ' + a)
end;
procedure yesorno1(a : boolean);
begin
if a then
write('yes')
else
write('no ')
end;
procedure yesorno2(a : boolean);
begin
yesorno1(a);
writeln
end;
procedure dontknow1;
begin
write('(unknown)')
end;
procedure dontknow2;
begin
dontknow1;
writeln
end;
procedure pause1;
var
xbyte : byte;
xchar : char;
begin
if wherey + hi(windmin) > hi(windmax) then begin
xbyte := textattr;
textcolor(green);
write('(continued)');
repeat
xchar := readkey
until not keypressed;
clrscr;
writeln('(continued)');
textattr := xbyte
end
end;
procedure CPUID(var a : cpu_info_t);
external;
procedure segofs1(a, b : word);
begin
write(hex(a, 4), ':', hex(b, 4))
end;
procedure segofs2(a, b : word);
begin
segofs1(a, b);
writeln
end;
function showchar(a : char) : char;
begin
if a in pchar then
showchar := a
else
showchar := '.'
end;
function bin4(a : byte) : string;
const
digit : array[0..1] of char = '01';
var
xstring : string;
i : byte;
begin
xstring := '';
for i := 3 downto 0 do begin
insert(digit[a mod 2], xstring, 1);
a := a shr 1
end;
bin4 := xstring
end;
procedure offoron(a : boolean);
begin
if a then
write('on')
else
write('off')
end;
procedure zeropad(a : word);
begin
if a < 10 then
write('0');
write(a)
end;
function cbw(a, b : byte) : word;
begin
cbw := b shl 8 + a
end;
function bin16(a : word) : string;
function bin8(a : byte) : string;
begin
bin8 := bin4(a shr 4) + '_' + bin4(a and $0F)
end;
begin (* function bin16 *)
bin16 := bin8(hi(a)) + '_' + bin8(lo(a))
end;
procedure drvname(a : byte);
begin
write(chr(ord('A') + a), ': ')
end;
procedure media(a : byte);
procedure diskette(a, b : byte);
begin
writeln('diskette (', a, '-sided, ', b, ' sectors)')
end;
begin (* procedure media *)
caption3('Media');
case a of
$FF : diskette(2, 8);
$FE : diskette(1, 8);
$FD : diskette(2, 9);
$FC : diskette(1, 9);
$F9 : diskette(2, 15);
$F8 : writeln('fixed disk')
else
unknown('media', a, 2)
end
end;
procedure pause2;
var
xbyte : byte;
xchar : char;
begin
xbyte := textattr;
textcolor(green);
write('(continued)');
repeat
xchar := readkey
until not keypressed;
textattr := xbyte
end;
function diskread(drive : byte; starting_sector, number_of_sectors : word
; var buffer) : word;
external;
(****************************************************************************)
procedure init;
const
qversion = 'Version 4.7';
var
xint : integer;
procedure rjustify(a : string);
begin
gotoxy(1 + lo(windmax) - length(a), wherey);
write(a)
end;
procedure border;
const
ch = '═';
var
i : byte;
begin
for i := 1 to twidth - 1 do
write(ch)
end;
begin (* procedure init *)
attrsave := textattr;
with regs do begin
AH := $0F;
intr($10, regs);
twidth := AH;
vidpg := BH;
intr($11, regs);
equip := AX;
intr($12, regs);
DOSmem := longint(AX) shl 10;
AH := $19;
MSDOS(regs);
currdrv := AL;
AH := $34;
MSDOS(regs);
DOScseg := ES;
DOScofs := BX;
AX := $3700;
MSDOS(regs);
switchar := chr(DL);
AX := $3800;
DS := seg(country);
DX := ofs(country);
MSDOS(regs);
ccode := BX;
AH := $52;
MSDOS(regs);
devseg := ES;
devofs := BX
end;
detectgraph(graphdriver, xint);
if (graphdriver = EGA) or (graphdriver = MCGA)
or (graphdriver = VGA) then
with regs do begin
AX := $1130;
BH := $00;
intr($10, regs);
tlength := DL + 1
end
else
tlength := 25;
for i := $00 to $FF do
getintvec(i, intvec[i]);
intvec[$00] := saveint00;
intvec[$02] := saveint02;
intvec[$1B] := saveint1B;
intvec[$23] := saveint23;
intvec[$24] := saveint24;
intvec[$34] := saveint34;
intvec[$35] := saveint35;
intvec[$36] := saveint36;
intvec[$37] := saveint37;
intvec[$38] := saveint38;
intvec[$39] := saveint39;
intvec[$3A] := saveint3A;
intvec[$3B] := saveint3B;
intvec[$3C] := saveint3C;
intvec[$3D] := saveint3D;
intvec[$3E] := saveint3E;
intvec[$3F] := saveint3F;
intvec[$75] := saveint75;
dirsep := ['\'];
if switchar <> '/' then
dirsep := dirsep + ['/'];
textbackground(black);
window(1, 1, twidth, tlength);
clrscr;
textcolor(green);
write('SYSID');
textcolor(lightgray);
write(' - System description for IBM PC''s and compatibles');
rjustify(qversion);
writeln;
border;
gotoxy(1, tlength - 1);
border;
writeln;
write('Page ');
x1 := wherex + lo(windmin);
write(pgmax, ' of ', pgmax);
textcolor(green);
rjustify('PgDn PgUp Home End Esc');
x2 := wherex + lo(windmin);
pg := 1
end;
(****************************************************************************)
procedure page_01;
const
BIOScseg = $C000;
BIOSext = $AA55;
PCROMseg = $F000;
var
xbool : boolean;
xbyte : byte;
xchar : char;
xlong : longint;
xword1 : word;
xword2 : word;
function BIOSscan(a, b, c : word; var d : word) : boolean;
const
max = 3;
notice : array[1..max] of string = ('(C)', 'COPR.', 'COPYRIGHT');
var
i : 1..max;
len : byte;
target : string;
xbool : boolean;
xlong : longint;
xword : word;
function scan(a : string; b, c, d : word; var e : word) : boolean;
var
i : longint;
j : byte;
len : byte;
xbool1 : boolean;
xbool2 : boolean;
begin
i := c;
len := length(a);
xbool1 := false;
repeat
if i <= longint(d) - len + 1 then begin
j := 0;
xbool2 := false;
repeat
if j < len then
if upcase(chr(mem[b : i + j])) = a[j + 1] then
inc(j)
else begin
xbool2 := true;
inc(i)
end
else begin
xbool2 := true;
xbool1 := true;
e := i;
scan := true
end
until xbool2
end else begin
xbool1 := true;
scan := false
end
until xbool1
end;
begin (* function BIOSscan *)
xlong := c;
xbool := false;
for i := 1 to max do begin
target := notice[i];
len := length(target);
if xbool then
xlong := longint(xword) - 2 + len;
if (xlong >= b) and (xlong <= c) and (scan(target, a, b, xlong, xword))
then
xbool := true
end;
if xbool then begin
while (xword > b) and (chr(mem[a : xword - 1]) in pchar) do
dec(xword);
d := xword
end;
BIOSscan := xbool
end;
procedure showBIOS(a, b : word);
var
xchar : char;
begin
xchar := chr(mem[a : b]);
while (xchar in pchar) and (b > $0000) do begin
write(xchar);
inc(b);
xchar := chr(mem[a : b])
end;
writeln
end;
begin (* procedure page_01 *)
caption2('Machine type');
with regs do begin
AH := $C0;
intr($15, regs);
if nocarry then begin
xword1 := memw[ES : BX + 2];
if (xword1 = $00FC) or (xword1 = $01FC) then
writeln('PC-AT 3x9')
else if (xword1 = $00FB) or (xword1 = $01FB) then
writeln('PC-XT/2')
else if xword1 = $02FC then
writeln('PC-XT/286')
else if xword1 = $00F9 then
writeln('PC-Convertible')
else if xword1 = $00FA then
writeln('PS/2 Model 30')
else if xword1 = $04FC then
writeln('PS/2 Model 50')
else if xword1 = $05FC then
writeln('PS/2 Model 60')
else if (xword1 = $04F8) or (xword1 = $09F8) then
writeln('PS/2 Model 70')
else if (xword1 = $00F8) or (xword1 = $01F8) then
writeln('PS/2 Model 80')
else if xword1 = $06FC then
writeln('7552 Gearbox')
else
unknown('machine - model/type word', xword1, 4);
caption3('BIOS revision level');
writeln(mem[ES : BX + 4]);
xbyte := mem[ES : BX + 5];
caption3('DMA channel 3 used');
yesorno2(xbyte and $80 = $80);
caption3('Slave 8259 present');
yesorno2(xbyte and $40 = $40);
caption3('Real-time clock');
yesorno2(xbyte and $20 = $20);
caption3('Keyboard intercept available');
yesorno2(xbyte and $10 = $10);
caption3('Wait for external event available');
yesorno2(xbyte and $08 = $08);
caption3('Extended BIOS data area segment');
if xbyte and $04 = $04 then begin
AH := $C1;
intr($15, regs);
if nocarry then
writeln(hex(ES, 4))
else
dontknow2;
end else
writeln('(none)');
caption3('Micro Channel');
yesorno2(xbyte and $02 = $02)
end else begin
xbyte := mem[$FFFF : $000E];
case xbyte of
$FF : writeln('PC');
$FE : writeln('PC-XT');
$FD : writeln('PCjr');
$FC : writeln('PC-AT')
else
unknown('machine - model byte', xbyte, 2)
end
end
end;
(* Byte 12:12 p. 174 *)
caption2('BIOS source');
if BIOSscan(PCROMseg, $E000, $FFFF, xword1) then
showBIOS(PCROMseg, xword1)
else
dontknow2;
caption2('BIOS date');
i := $0005;
xbool := true;
xchar := chr(mem[$FFFF : i]);
while (i < $0010) and (xchar in pchar) do begin
xbool := false;
write(xchar);
inc(i);
xchar := chr(mem[$FFFF : i])
end;
if xbool then
dontknow1;
writeln;
caption2('BIOS extensions');
xword1 := BIOScseg;
xbool := true;
for i := 0 to 23 do begin
if (memw[xword1 : 0] = BIOSext) then begin
if xbool then begin
writeln;
window(3, wherey + hi(windmin), twidth, tlength - 2);
caption1('Segment Copyright notice');
writeln;
xbool := false
end;
pause1;
write(hex(xword1, 4), ' ');
if BIOSscan(xword1, $0000, $1FFF, xword2) then
showBIOS(xword1, xword2)
else
dontknow2
end;
inc(xword1, $0200)
end;
if xbool then
writeln('(none)')
end;
(****************************************************************************)
procedure page_02;
var
cpu_info : cpu_info_t;
procedure showNDP(a : string; b : word);
begin
writeln(a);
caption2(' Infinity');
case b and $1000 of
$0000 : writeln('projective');
$1000 : writeln('affine')
end;
caption2(' Rounding');
case b and $0C00 of
$0000 : writeln('to nearest or even');
$0400 : writeln('down');
$0800 : writeln('up');
$0C00 : writeln('chop')
end;
caption2(' Precision');
case b and $0300 of
$0000 : writeln('24 bits');
$0100 : writeln('(reserved)');
$0200 : writeln('53 bits');
$0300 : writeln('64 bits')
end
end;
begin (* procedure page_02 *)
caption2('CPU');
CPUID(cpu_info);
with cpu_info do begin
case cpu_type of
$00 : writeln('8088');
$01 : writeln('8086');
$02 : writeln('V20');
$03 : writeln('V30');
$04 : writeln('80188');
$05 : writeln('80186');
$06 : writeln('80286');
$07 : writeln('80386')
else
unknown('CPU', cpu_type, 2)
end;
case cpu_type of
$06..$07 : begin
caption3('Machine State Word');
writeln(hex(MSW, 4));
caption3('Global Descriptor Table ');
for i := 1 to 6 do
write(hex(GDT[i], 2), ' ');
writeln;
caption3('Interrupt Descriptor Table');
for i := 1 to 6 do
write(hex(IDT[i], 2), ' ');
writeln
end
end;
case cpu_type of
07 : begin
caption3('Operand size (bits)');
if opsize then
writeln('32')
else
writeln('16')
end
end;
caption3('Interrupts enabled correctly after segment register'
+ ' change');
yesorno2(chkint);
case cpu_type of
07 : begin
caption3('Multiplication correct');
yesorno2(mult)
end
end;
caption2('Coprocessor');
case ndp_type of
$00 : writeln('none');
$01 : showNDP('8087', ndp_cw);
$02 : showNDP('80287', ndp_cw);
$03 : showNDP('80387', ndp_cw)
else
dontknow2
end
end;
caption2('Coprocessor enabled');
yesorno2(equip and $0002 = $0002)
end;
(****************************************************************************)
procedure page_03;
const
EMMint = $67;
qEMMdrvr = 'EMMXXXX0';
var
EMMarray : array[$000..$3FF] of word;
xlong : longint;
xword1 : word;
xword2 : word;
xstring : string;
procedure EMMerr(a : byte);
begin
case a of
$80 : writeln('internal error in EMM software');
$81 : writeln('malfunction in expanded memory hardware');
$82 : writeln('memory manager busy');
$83 : writeln('invalid handle');
$84 : writeln('undefined function');
$85 : writeln('no more handles available');
$86 : writeln('error in save or restore of mapping context');
$87 : writeln('not enough physical pages available');
$88 : writeln('not enough free pages available');
$89 : writeln('no pages requested');
$8A : writeln('logical page outside range assigned to handle');
$8B : writeln('invalid physical page number');
$8C : writeln('page map hardware state save area full');
$8D : writeln('mapping context already in save area');
$8E : writeln('mapping context not in save area');
$8F : writeln('undefined subfunction parameter')
else
unknown('expanded memory error', a, 2)
end
end;
begin (* procedure page_03 *)
caption2('Total conventional memory (bytes)');
writeln(DOSmem : 6);
caption2('Free conventional memory (bytes) ');
writeln(DOSmem - longint(prefixseg) shl 4 : 6);
caption2('Extended memory (bytes) ');
with regs do begin
AH := $88;
intr($15, regs);
if nocarry then begin
writeln(longint(AX) shl 10 : 8);
caption3('XMM installed');
AX := $4300;
intr($2F, regs);
if nocarry and (AL = $80) then begin
writeln('yes');
caption3('XMM entry address');
AX := $4310;
intr($2F, regs);
if nocarry then
segofs2(ES, BX)
else
dontknow2
end else
writeln('no')
(* PC Magazine 8:12 pg. 321 *)
end else
writeln(' N/A')
end;
caption2('Expanded memory');
if longint(intvec[EMMint]) <> $00000000 then begin
writeln;
caption3('Interrupt vector');
xlong := longint(intvec[EMMint]);
xword1 := xlong shr 16;
xword2 := xlong and $0000FFFF;
segofs2(xword1, xword2);
caption3('Driver');
xstring := '';
for i := $000A to $0011 do
xstring := xstring + showchar(chr(mem[xword1 : i]));
write(xstring);
if xstring = qEMMdrvr then begin
writeln;
caption3('Manager status');
with regs do begin
AH := $40;
intr(EMMint, regs);
if AH = $00 then
writeln('OK')
else
EMMerr(AH);
caption3('Page frame segment');
AH := $41;
intr(EMMint, regs);
if AH = $00 then
writeln(hex(BX, 4))
else
EMMerr(AH);
caption3('Total EMS memory (16K pages)');
AH := $42;
intr(EMMint, regs);
if AH = $00 then
writeln(DX : 3)
else
EMMerr(AH);
caption3('Free EMS memory (16K pages) ');
if AH = $00 then
writeln(BX : 3)
else
EMMerr(AH);
caption3('EMM version');
AH := $46;
intr(EMMint, regs);
if AH = $00 then
writeln(AL shr 4, chr(country[9]), AL and $0F)
else
EMMerr(AH);
caption1(' Handle 16K pages');
writeln;
AH := $4D;
ES := seg(EMMarray);
DI := ofs(EMMarray);
intr(EMMint, regs);
if AH = $00 then
if BX > $0000 then begin
window(3, wherey + hi(windmin), twidth, tlength - 2);
for i := 1 to BX do begin
pause1;
writeln(hex(EMMarray[2 * i - 2], 4), ' '
, EMMarray[2 * i - 1] : 3)
end
end else
writeln(' (no active handles)')
else
EMMerr(AH)
end
end else
dontknow2
end else
writeln('(none)')
end;
(****************************************************************************)
procedure page_04;
var
xbyte : byte;
xword1 : word;
xword2 : word;
xword3 : word;
xword4 : word;
procedure showMCB(MCB, ownerPID, parent, size : word);
var
i : word;
xchar : char;
xlong1 : longint;
xlong2 : longint;
xlong3 : longint;
xstring : string;
xword : word;
begin
xlong1 := longint(size) shl 4;
xword := memw[ownerPID : $002C];
if ownerPID = $0008 then
xstring := 'IBMDOS.COM'
else if ownerPID = parent then
xstring := 'COMMAND.COM'
(* BIX ms.dos/secrets #1496 *)
(* Software Tools #145, p. 56 *)
else if (ownerPID = $0000) or (ownerPID = prefixseg) then
xstring := '(free)'
else begin
i := 0;
while memw[xword : i] > $0000 do
inc(i);
inc(i, 4);
xstring := '';
xchar := chr(mem[xword : i]);
while xchar in pchar do begin
if xchar in dirsep then
xstring := ''
else
xstring := xstring + xchar;
inc(i);
xchar := chr(mem[xword : i])
end;
if xchar > #0 then
xstring := ''
end;
write(hex(MCB, 4), ' ', hex(ownerPID, 4), ' ', hex(parent, 4), ' '
, xlong1 : 6, ' ');
if xword = MCB + 1 then
write(' ■ ')
else
write(' ');
write(' ', xstring);
if MCB + 1 = ownerPID then begin
for i := length(xstring) + 1 to 12 do
write(' ');
write(' ');
xlong2 := longint(ownerPID) shl 4;
for i := $00 to $FF do begin
xlong3 := longint(intvec[i]) and $FFFF0000 shr 12
+ longint(intvec[i]) and $0000FFFF;
if (xlong2 <= xlong3) and (xlong3 <= xlong2 + xlong1) then begin
if wherex > twidth - 3 then begin
writeln;
pause1;
write(' '
, ' ')
end;
write(' ', hex(i, 2))
end
end
end;
writeln
end;
begin (* procedure page_04 *)
caption1('MCB PSP Parent Size Env Owner'
+ ' Interrupts');
writeln;
window(1, wherey + hi(windmin), twidth, tlength - 2);
xword1 := memw[devseg : devofs - $0002];
repeat
xbyte := mem[xword1 : $0000];
xword2 := memw[xword1 : $0001];
xword3 := memw[xword2 : $0016];
pause1;
case xbyte of
$4D : begin
xword4 := memw[xword1 : $0003];
showMCB(xword1, xword2, xword3, xword4);
inc(xword1, 1 + xword4)
end;
$5A : begin
xword4 := DOSmem shr 4 - xword1 - 1;
showMCB(xword1, xword2, xword3, xword4)
end else
unknown('MCB status', xbyte, 2)
end
until xbyte <> $4D
(* PC Magazine 6:14 p.425 *)
end;
(****************************************************************************)
procedure page_05;
var
i : byte;
xbyte : byte;
xint1 : integer;
xint2 : integer;
xword : word;
procedure showdisp(a : string; b : byte);
begin
caption2(a);
case b of
$00 : writeln('(none)');
$01 : writeln('MDA + 5151');
$02 : writeln('CGA + 5153/5154');
$03 : writeln('(reserved)');
$04 : writeln('EGA + 5153/5154');
$05 : writeln('EGA 5151');
$06 : writeln('PGA + 5175');
$07 : writeln('VGA + analog monochrome');
$08 : writeln('VGA + analog color');
$09 : writeln('(reserved)');
$0A : writeln('MCGA + digital color');
$0B : writeln('MCGA + digital monochrome');
$0C : writeln('MCGA + analog color');
$0D..$FE : writeln('(reserved)');
$FF : dontknow2
end
end;
procedure showcolor(a : byte);
begin
case a of
black : write('black');
blue : write('blue');
green : write('green');
cyan : write('cyan');
red : write('red');
magenta : write('magenta');
brown : write('brown');
lightgray : write('light gray');
darkgray : write('dark gray');
lightblue : write('light blue');
lightgreen : write('light green');
lightcyan : write('light cyan');
lightred : write('light red');
lightmagenta : write('light magenta');
yellow : write('yellow');
white : write('white')
else
unknown('color', a, 2)
end
end;
begin (* procedure page_05 *)
with regs do begin
AX := $1A00;
intr($10, regs);
if AL = $1A then begin
showdisp('Active video subsystem ', BL);
showdisp('Inactive video subsystem', BH)
end
end;
caption2('Initial video mode');
case equip and $0030 of
$0000 : writeln('No display');
$0010 : writeln('40 x 25 color');
$0020 : writeln('80 x 25 color');
$0030 : writeln('80 x 25 monochrome')
end;
caption2('Current video mode');
xbyte := lo(lastmode);
write(xbyte, ' ');
case xbyte of
$00 : writeln('(40 x 25 b/w text)');
$01 : writeln('(40 x 25 color text)');
$02 : writeln('(80 x 25 b/w text)');
$03 : writeln('(80 x 25 color text)');
$04 : writeln('(320 x 200 4 colors)');
$05 : writeln('(320 x 200 4 colors, no color burst)');
$06 : writeln('(640 x 200 2 colors)');
$07 : writeln('(MDA text)');
$08 : writeln('(160 x 200 16 colors)');
$09 : writeln('(320 x 200 16 colors)');
$0A : writeln('(640 x 200 4 colors)');
$0D : writeln('(320 x 200 16 colors)');
$0E : writeln('(640 x 200 16 colors)');
$0F : writeln('(640 x 350 monochrome)');
$10 : writeln('(640 x 350 16 colors)');
$11 : writeln('(640 x 480 2 colors)');
$12 : writeln('(640 x 480 16 colors)');
$13 : writeln('(640 x 480 256 colors)')
else
unknown('video mode', xbyte, 2)
end;
caption2('Current display page');
writeln(vidpg);
caption2('Graphics modes');
getmoderange(graphdriver, xint1, xint2);
if graphresult = grok then
writeln(xint2 + 1 - xint1)
else
writeln(0);
caption2('Video buffer (offset)');
writeln(hex(memw[BIOSdseg : $004E], 4));
caption2('Video buffer size (bytes)');
writeln(memw[BIOSdseg : $004C]);
caption2('Active display port');
xword := memw[BIOSdseg : $0063];
write('$', hex(xword, 3), ' ');
if xword = $03B4 then
writeln('(monochrome)')
else if xword = $03D4 then
writeln('(color)')
else
dontknow2;
caption2('CRT mode register');
writeln('$', hex(mem[BIOSdseg : $0065], 2));
caption2('Current palette');
writeln('$', hex(mem[BIOSdseg : $0066], 2));
caption2('Colors');
caption1('·');
for i := black to white do begin
textcolor(i);
write('█')
end;
caption1('·');
writeln;
caption2('Current colors');
if (attrsave and $80) = $80 then
write('blinking ');
showcolor(attrsave and $0F);
write(' on ');
showcolor(attrsave and $70 shr 4);
writeln;
caption2('Text rows');
writeln(tlength);
caption2('Text columns');
writeln(twidth);
if graphdriver in [EGA, MCGA, VGA] then begin
caption2('Scan lines/character');
with regs do begin
AX := $1130;
BH := $00;
intr($10, regs);
writeln(CX)
end
end;
caption2('Cursor scan lines');
with regs do begin
AH := $03;
BH := vidpg;
intr($10, regs);
writeln(CH, '-', CL)
end
end;
(****************************************************************************)
procedure page_06;
var
i : byte;
VGAbuf : array[$00..$10] of byte;
xbyte : byte;
xword1 : word;
xword2 : word;
xword3 : word;
xword4 : word;
procedure captfont;
begin
caption1('Font Address');
writeln;
write('INT 1FH ');
segofs2(longint(intvec[$1F]) shr 16, longint(intvec[$1F]) and $0000FFFF)
end;
procedure showfont(a : byte);
begin
with regs do begin
case a of
$00 : write('INT 1FH ');
$01 : write('INT 43H ');
$02 : write('ROM 8x14 ');
$03 : write('ROM 8x8 (lo)');
$04 : write('ROM 8x8 (hi)');
$05 : write('ROM 9x14 ');
$06 : write('ROM 8x16 ');
$07 : write('ROM 9x16 ')
end;
write(' ');
AX := $1130;
BH := a;
intr($10, regs);
segofs2(ES, BP)
end
end;
procedure int101210;
begin
with regs do begin
AH := $12;
BL := $10;
intr($10, regs);
caption2('Display type');
case BH of
$00 : writeln('color');
$01 : writeln('monochrome')
else
unknown('display', BH, 2)
end;
caption2('Memory');
case BL of
$00 : writeln('64K');
$01 : writeln('128K');
$02 : writeln('192K');
$03 : writeln('256K')
else
unknown('size', BL, 2)
end;
caption2('Feature bits');
writeln(bin4(CH and $0F));
caption2('DIP switches');
writeln(bin4(CL and $0F))
end
end;
begin (* procedure page_06 *)
caption2('Display adapter');
case graphdriver of
CGA : begin
writeln('CGA');
captfont
end;
MCGA : begin
writeln('MCGA');
captfont;
showfont($01);
showfont($03);
showfont($04);
showfont($06)
end;
EGA..EGAmono : begin
writeln('EGA');
captfont;
showfont($01);
showfont($02);
showfont($03);
showfont($04);
showfont($05);
int101210;
xbyte := mem[BIOSdseg : $0087];
caption2('Mode change preserves screen buffer');
yesorno2(xbyte and $80 = $80);
caption2('EGA active');
yesorno2(xbyte and $08 = $00);
caption2('Wait for display enable');
yesorno2(xbyte and $04 = $04);
caption2('CGA cursor emulation');
yesorno2(xbyte and $01 = $00);
(* PC Magazine 6:12 p.326 *)
caption2('Save area ');
xword1 := memw[BIOSdseg : $00AA];
xword2 := memw[BIOSdseg : $00A8];
segofs2(xword1, xword2);
(* PC Tech Journal 3:4 p.65 *)
caption2('Video parameter table ');
segofs2(memw[xword1 : xword2 + 2], memw[xword1 : xword2]);
caption2('Dynamic save area ');
xword3 := memw[xword1 : xword2 + 6];
xword4 := memw[xword1 : xword2 + 4];
if (xword3 > $0000) or (xword4 > $0000) then
segofs2(xword3, xword4)
else
writeln('(none)');
caption2('Auxiliary character generator');
xword3 := memw[xword1 : xword2 + 10];
xword4 := memw[xword1 : xword2 + 8];
if (xword3 > $0000) or (xword4 > $0000) then
segofs2(xword3, xword4)
else
writeln('(none)');
caption2('Graphics mode auxiliary table');
xword3 := memw[xword1 : xword2 + 14];
xword4 := memw[xword1 : xword2 + 12];
if (xword3 > $0000) or (xword4 > $0000) then
segofs1(xword3, xword4)
else
write('(none)')
(* PC Tech Journal 3:4 p.67 *)
end;
hercmono : begin
writeln('Hercules or MDA');
captfont
end;
IBM8514 : begin
writeln('IBM 8514');
captfont
end;
ATT400 : begin
writeln('AT&T 400');
captfont
end;
VGA : begin
writeln('VGA');
captfont;
showfont($01);
showfont($02);
showfont($03);
showfont($04);
showfont($05);
showfont($06);
showfont($07);
int101210;
with regs do begin
AX := $1009;
ES := seg(VGAbuf);
DX := ofs(VGAbuf);
intr($10, regs)
end;
caption2('Palette registers');
for i := $00 to $0F do
write(hex(VGAbuf[i], 2), ' ');
writeln;
caption2('Border color');
writeln(hex(VGAbuf[$10], 2));
caption2('Color page');
with regs do begin
AX := $101A;
intr($10, regs);
writeln('$', hex(BH, 2));
caption2('Paging mode');
case BL of
$00 : writeln('4 pages of 64 registers');
$01 : writeln('16 pages of 16 registers')
else
unknown('mode', BL, 2)
end
end
end;
PC3270 : begin
writeln('3270 PC');
captfont
end else
unknown('adapter', graphdriver, 4)
end
end;
(****************************************************************************)
procedure page_07;
const
mouseint = $33;
var
xbyte : byte;
xword1 : word;
xword2 : word;
begin
caption2('Keyboard');
writeln;
caption3('BIOS support for enhanced keyboard');
with regs do begin
AH := $02;
intr($16, regs);
xbyte := AL;
AX := $1200 + xbyte xor $FF;
intr($16, regs);
if AL = xbyte then begin
writeln('yes');
caption3('Enhanced keyboard present');
yesorno2(mem[BIOSdseg : $0096] and $10 = $10)
end else
writeln('no');
(* PC Magazine 6:15 p.378 *)
AH := $02;
intr($16, regs);
caption3('Insert');
offoron(AL and $80 = $80);
caption1(' Caps Lock: ');
offoron(AL and $40 = $40);
caption1(' Num Lock: ');
offoron(AL and $20 = $20);
caption1(' Scroll Lock: ');
offoron(AL and $10 = $10);
writeln
end;
caption3('Buffer');
xword1 := memw[BIOSdseg : $0080];
segofs1(BIOSdseg, xword1);
xword2 := memw[BIOSdseg : $0082];
writeln('-', hex(xword2, 4));
caption3('Buffer size (keystrokes)');
writeln((xword2 - xword1) shr 1 - 1);
caption2('Internal modem/serial printer');
yesorno2(equip and $2000 = $2000);
caption2('Game port');
yesorno2(equip and $1000 = $1000);
caption2('Mouse');
with regs do begin
AX := $0000;
intr(mouseint, regs);
if AX = $FFFF then begin
writeln('yes');
caption3('Buttons');
writeln(BX);
caption3('Save state buffer size (bytes)');
AX := $0015;
BX := $FFFF;
intr(mouseint, regs);
if BX < $FFFF then
writeln(BX)
else
dontknow2;
caption3('Mickeys/pixel (horizontal)');
AX := $001B;
BX := $FFFF;
CX := $FFFF;
DX := $FFFF;
intr(mouseint, regs);
if BX < $FFFF then
writeln(BX : 5)
else
dontknow2;
caption3('Mickeys/pixel (vertical) ');
if CX < $FFFF then
writeln(CX : 5)
else
dontknow2;
caption3('Double speed threshold');
if DX < $FFFF then
writeln(DX)
else
dontknow2;
caption3('Current display page');
AX := $001E;
BX := $FFFF;
intr(mouseint, regs);
if BX < $FFFF then
writeln(BX)
else
dontknow2;
caption3('Language');
AX := $0023;
BX := $FFFF;
intr(mouseint, regs);
if BX < $FFFF then
if BX = $0000 then
writeln('English')
else if BX = $0001 then
writeln('French')
else if BX = $0002 then
writeln('Dutch')
else if BX = $0003 then
writeln('German')
else if BX = $0004 then
writeln('Swedish')
else if BX = $0005 then
writeln('Finnish')
else if BX = $0006 then
writeln('Spanish')
else if BX = $0007 then
writeln('Portuguese')
else if BX = $0008 then
writeln('Italian')
else
unknown('language', BX, 4)
else
dontknow2;
caption3('Driver version');
AX := $0024;
BX := $FFFF;
CX := $FFFF;
intr(mouseint, regs);
if BX < $FFFF then begin
write(BH, chr(country[9]));
zeropad(BL)
end else
dontknow1;
writeln;
caption3('Type');
if CX < $FFFF then
case CH of
$01 : writeln('bus');
$02 : writeln('serial');
$03 : writeln('InPort');
$04 : writeln('PS/2');
$05 : writeln('HP')
else
unknown('mouse', CH, 2)
end
else
dontknow2;
caption3('Interrupt');
if CX < $FFFF then
case CL of
$00 : writeln('PS/2');
$02..$05, $07 : writeln('IRQ', CL)
else
unknown('interrupt', CL, 2)
end
else
dontknow2
end else
writeln('no')
end
end;
(****************************************************************************)
procedure page_08;
const
tick2 = 115200;
var
i : byte;
xbyte1 : byte;
xbyte2 : byte;
xword : word;
y : byte;
begin
y := wherey + hi(windmin);
window(1, y, 30, tlength - 2);
caption2('Printers');
xbyte1 := equip and $C000 shr 14;
writeln(xbyte1);
if xbyte1 > 0 then begin
caption3('Device');
writeln;
caption3('Base port');
writeln;
caption3('Timeout');
writeln;
caption3('Busy');
writeln;
caption3('ACK');
writeln;
caption3('Paper out');
writeln;
caption3('Selected');
writeln;
caption3('I/O error');
writeln;
caption3('Timed out');
for i := 1 to xbyte1 do begin
window(9 + 6 * i, y + 1, 15 + 6 * i, tlength - 2);
writeln('LPT', i);
writeln('$', hex(memw[BIOSdseg : 2 * i + 6], 3));
writeln(mem[BIOSdseg : $0077 + i]);
with regs do begin
AH := $02;
DX := 0;
intr($17, regs);
yesorno2(AH and $80 = $00);
yesorno2(AH and $40 = $40);
yesorno2(AH and $20 = $20);
yesorno2(AH and $10 = $10);
yesorno2(AH and $08 = $08);
yesorno2(AH and $01 = $01)
end
end
end;
window(twidth - 42, y, twidth, tlength - 2);
caption2('Serial ports');
xbyte1 := equip and $0E00 shr 9;
writeln(xbyte1);
if xbyte1 > 0 then begin
if xbyte1 > 4 then
xbyte1 := 4;
caption3('Device');
writeln;
caption3('Base port');
writeln;
caption3('Timeout');
writeln;
caption3('Baud rate');
writeln;
caption3('Data bits');
writeln;
caption3('Parity');
writeln;
caption3('Stop bits');
writeln;
caption3('Break');
writeln;
caption3('RLSD');
writeln;
caption3('RI');
writeln;
caption3('DSR');
writeln;
caption3('CTS');
writeln;
caption3('dRLSD');
writeln;
caption3('-dRI');
writeln;
caption3('dDSR');
writeln;
caption3('dCTS');
for i := 1 to xbyte1 do begin
window(twidth - 35 + 7 * i, y + 1, twidth - 28 + 7 * i
, tlength - 2);
writeln('COM', i);
xword := memw[BIOSdseg : 2 * i - 2];
writeln('$', hex(xword, 3));
writeln(mem[BIOSdseg : $007B + i]);
xbyte2 := port[xword + 3];
port[xword + 3] := xbyte2 or $80;
writeln(tick2 / cbw(port[xword], port[xword + 1]) : 0 : 0);
port[xword + 3] := xbyte2;
case xbyte2 and $03 of
$00 : writeln('5');
$01 : writeln('6');
$02 : writeln('7');
$03 : writeln('8')
end;
case xbyte2 and $38 of
$00, $10, $20, $30 : writeln('none');
$08 : writeln('odd');
$18 : writeln('even');
$28 : writeln('mark');
$38 : writeln('space')
end;
case xbyte2 and $07 of
$00..$03 : writeln('1');
$04 : writeln('1.5');
$05..$07 : writeln('2')
end;
yesorno2(xbyte2 and $40 = $40);
with regs do begin
AH := $03;
DX := i - 1;
intr($14, regs);
yesorno2(AL and $80 = $80);
yesorno2(AL and $40 = $40);
yesorno2(AL and $20 = $20);
yesorno2(AL and $10 = $10);
yesorno2(AL and $08 = $08);
yesorno2(AL and $04 = $04);
yesorno2(AL and $02 = $02);
yesorno2(AL and $01 = $01)
end
end
end
end;
(****************************************************************************)
procedure page_09;
const
filesmax = 256;
var
f : array[1..filesmax] of file;
i : 0..filesmax;
j : 1..filesmax;
xbool : boolean;
xbyte : byte;
xchar : char;
xstring1 : string;
xstring2 : string;
xword1 : word;
xword2 : word;
xword3 : word;
xword4 : word;
xword5 : word;
y : byte;
procedure showecho(a : word);
var
xbyte : byte;
begin
xbyte := mem[DOScseg : a];
case xbyte of
$00 : writeln('off');
$FF : writeln('on')
else
unknown('status', xbyte, 2)
end
end;
begin (* procedure page_09 *)
y := wherey + hi(windmin);
window(1, y, twidth div 2, tlength - 2);
caption2('DOS version');
with regs do begin
AH := $30;
MSDOS(regs);
write(AL, chr(country[9]));
zeropad(AH);
writeln;
caption2('OEM serial # ');
writeln(BH);
caption2('User serial #');
writeln(longint(BL) shl 16 + CX)
end;
caption2('System date');
getdate(xword1, xword2, xword3, xword4);
if xword4 = 0 then
write('Sunday')
else if xword4 = 1 then
write('Monday')
else if xword4 = 2 then
write('Tuesday')
else if xword4 = 3 then
write('Wednesday')
else if xword4 = 4 then
write('Thursday')
else if xword4 = 5 then
write('Friday')
else if xword4 = 6 then
write('Saturday')
else
write('(', hex(xword4, 4), ')');
write(', ');
xword5 := cbw(country[0], country[1]);
xchar := chr(country[11]);
if xword5 = $0000 then
writeln(xword2, xchar, xword3, xchar, xword1)
else if xword5 = $0001 then
writeln(xword3, xchar, xword2, xchar, xword1)
else if xword5 = $0002 then
writeln(xword1, xchar, xword2, xchar, xword3)
else
writeln(xword2, xchar, xword3, xchar, xword1);
caption2('System time');
gettime(xword1, xword2, xword3, xword4);
zeropad(xword1);
write(chr(country[13]));
zeropad(xword2);
write(chr(country[13]));
zeropad(xword3);
write(chr(country[9]));
zeropad(xword4);
writeln;
caption2('Command load paragraph');
writeln(hex(prefixseg, 4));
caption2('Ctrl-C check');
getcbreak(xbool);
offoron(xbool);
writeln;
caption2('Disk verify');
getverify(xbool);
offoron(xbool);
writeln;
caption2('Switch prefix character');
writeln(switchar);
caption2('\DEV\ prefix for devices');
with regs do begin
AX := $3702;
MSDOS(regs);
if DL = $00 then
writeln('required')
else
writeln('optional')
end;
caption2('Reset boot');
xword1 := memw[BIOSdseg : $72];
if xword1 = $0000 then
writeln('cold')
else if (xword1 = $1234) or (xword1 = $1200) then
writeln('bypass memory test')
else if xword1 = $4321 then
writeln('preserve memory')
else if xword1 = $5678 then
writeln('system suspended')
else if xword1 = $9ABC then
writeln('manufacturing test mode')
else if xword1 = $ABCD then
writeln('system POST loop mode')
else
unknown('flag', xword1, 4);
(* Byte 12:12 p.178 *)
with regs do begin
caption2('DOS critical flag');
AX := $5D06;
MSDOS(regs);
segofs2(DS, SI)
end;
caption2('DOS busy flag ');
segofs2(DOScseg, DOScofs);
caption2('Printer echo');
case osminor of
0..9 : dontknow2;
10..39 : showecho($02AC)
else
dontknow2
end;
(* BIX ms.dos/secrets #501 *)
caption2('PrtSc status');
xbyte := mem[BIOSdseg : $0100];
case xbyte of
$00 : writeln('ready');
$01 : writeln('busy');
$FF : writeln('error on last PrtSc')
else
unknown('status', xbyte, 2)
end;
caption2('Memory allocation');
with regs do begin
AX := $5800;
MSDOS(regs);
if AX = $0000 then
writeln('first fit')
else if AX = $0001 then
writeln('best fit')
else
writeln('last fit')
end;
window(1 + twidth div 2, y, twidth, tlength - 2);
caption2('DOS buffers');
xword1 := 0;
xword2 := memw[devseg : devofs + $0014];
xword3 := memw[devseg : devofs + $0012];
while (xword2 < $FFFF) or (xword3 < $FFFF) do begin
inc(xword1);
xword4 := memw[xword2 : xword3 + $0002];
xword3 := memw[xword2 : xword3];
xword2 := xword4
end;
writeln(xword1);
caption2('Buffer size (bytes)');
writeln(memw[devseg : devofs + $0010]);
(* BIX ms.dos/long.messages #228 *)
caption2('File handle table');
xword1 := memw[prefixseg : $0036];
xword2 := memw[prefixseg : $0034];
segofs2(xword1, xword2);
caption2('File handle table length');
writeln(mem[prefixseg : $0032] : 3);
caption2('File handles used ');
i := 0;
while mem[xword1 : xword2] < $FF do begin
inc(i);
inc(xword2)
end;
writeln(i : 3);
caption1('File handles free');
i := 0;
xbool := false;
xstring1 := getenv('comspec');
repeat
if i < filesmax then begin
assign(f[i + 1], xstring1);
reset(f[i + 1]);
if ioresult = 0 then
inc(i)
else begin
xbool := true;
caption2(' ');
writeln(i : 3)
end
end else begin
xbool := true;
caption2('');
dontknow2
end
until xbool;
for j := 1 to i do
close(f[j]);
caption2('Global code page');
with regs do begin
AX := $6601;
MSDOS(regs);
if AL = $01 then begin
writeln;
caption3('Active ');
writeln(BX : 5);
caption3('Default');
writeln(DX : 5)
end else
writeln('N/A')
end;
caption2('Country code');
writeln(ccode);
caption2('Thousands separator character');
writeln(chr(country[7]));
caption2('Decimal separator character');
writeln(chr(country[9]));
caption2('Data-list separator character');
writeln(chr(country[22]));
caption2('Date format');
xword1 := cbw(country[0], country[1]);
xchar := chr(country[11]);
if xword1 = $0000 then
writeln('USA (mm', xchar, 'dd', xchar, 'yy)')
else if xword1 = $0001 then
writeln('Europe (dd', xchar, 'mm', xchar, 'yy)')
else if xword1 = $0002 then
writeln('Japan (yy', xchar, 'mm', xchar, 'dd)')
else
unknown('format', xword1, 4);
caption3('Separator character');
writeln(xchar);
caption2('Time format');
if (country[17] and $01) = $00 then
write('12')
else
write('24');
writeln('-hour');
caption3('Separator character');
writeln(chr(country[13]));
caption2('Currency format');
xstring1 := 'xxxx';
insert(chr(country[7]), xstring1, 2);
xstring1 := xstring1 + chr(country[9]);
for i := 1 to country[16] do
xstring1 := xstring1 + 'y';
xstring2 := '';
i := 2;
xchar := chr(country[i]);
while (i <= 6) and (xchar > #0) do begin
xstring2 := xstring2 + xchar;
inc(i);
xchar := chr(country[i])
end;
case country[15] and $03 of
$00 : xstring1 := xstring2 + xstring1;
$01 : xstring1 := xstring1 + xstring2;
$02 : xstring1 := xstring2 + ' ' + xstring1;
$03 : xstring1 := xstring1 + ' ' + xstring2;
$04 : begin
delete(xstring1, 6, 1);
insert(xstring2, xstring1, 6)
end
end;
writeln(xstring1);
caption2('Case map call address');
segofs2(cbw(country[20], country[21]), cbw(country[18], country[19]))
end;
(****************************************************************************)
procedure page_10;
var
i : word;
xchar : char;
procedure muxint(a : string; b : byte);
begin
caption3(a);
with regs do begin
AX := b shl 8;
intr($2F, regs);
if nocarry then
case AL of
$00 : writeln('no, OK to install');
$01 : writeln('no, not OK to install');
$FF : writeln('yes')
else
unknown('status', AL, 2)
end
else
writeln('N/A')
end
end;
begin (* procedure page_10 *)
caption2('Multiplex interrupt ($2F)');
writeln;
muxint('PRINT ', $01);
muxint('ASSIGN ', $06);
(*
** Byte 12:12 p. 176C, Duncan, and many others, all of whom mistakenly give
** AH = $02
*)
(*
muxint('DRIVER.SYS ', $08);
*)
muxint('SHARE ', $10);
(*
muxint('FASTOPEN ', $12);
*)
muxint('NLSFUNC ', $14);
muxint('GRAFTABL ', $B0);
(*
muxint('DISPLAY.SYS ', $B0);
*)
muxint('APPEND ', $B7);
(*
muxint('KEYB ', $B8);
*)
muxint('NETBIOS APPEND ', $87);
muxint('NETBIOS NETWORK', $88);
(* Byte 12:12 p. 180. PC Tech Journal 3:11 p.104 gives AH = $BB *)
with regs do begin
AX := $B700;
intr($2F, regs);
if AL = $FF then begin
caption2('APPEND');
writeln;
caption3('Path');
AX := $B704;
intr($2F, regs);
if nocarry then begin
xchar := chr(mem[ES : DI]);
while xchar > #0 do begin
write(xchar);
inc(DI);
xchar := chr(mem[ES : DI])
end;
writeln
end else
dontknow2;
end
end;
with regs do begin
AX := $0100;
intr($2F, regs);
if AL = $FF then begin
caption2('PRINT queue');
AX := $0104;
intr($2F, regs);
xchar := chr(mem[DS : SI]);
if xchar > #0 then begin
writeln;
window(3, wherey + hi(windmin), twidth, tlength - 2);
repeat
pause1;
i := SI;
xchar := chr(mem[DS : i]);
repeat
write(xchar);
inc(i);
xchar := chr(mem[DS : i])
until xchar = #0;
writeln;
inc(SI, 64);
xchar := chr(mem[DS : SI])
until xchar = #0
end else
writeln('(empty)');
AX := $0105;
intr($2F, regs)
end
end
end;
(****************************************************************************)
procedure page_11;
begin
caption2('Environment');
window(3, wherey + hi(windmin) + 1, twidth, tlength - 2);
for i := 1 to envcount do begin
pause1;
writeln(envstr(i))
end
end;
(****************************************************************************)
procedure page_12;
const
headermin = 0;
headermax = 17;
nuldev : string = 'NUL ';
var
FCB : array[$00..$24] of byte;
header : array[headermin..headermax] of byte;
i : byte;
xword1 : word;
xword2 : word;
begin
caption1('Device Units Header Attributes'
+ ' Strategy Interrupt');
writeln;
window(1, wherey + hi(windmin), twidth, tlength - 2);
case osminor of
0..9 : begin
fillchar(FCB, sizeof(FCB), 0);
for i := 1 to 11 do
FCB[i] := ord(nuldev[i]);
with regs do begin
AH := $0F;
DS := seg(FCB);
DX := ofs(FCB);
MSDOS(regs)
end;
xword1 := cbw(FCB[$1C], FCB[$1D]);
xword2 := cbw(FCB[$1A], FCB[$1B])
end;
10..39 : begin
xword1 := devseg;
xword2 := devofs + $0022
end
end;
while xword2 < $FFFF do begin
pause1;
for i := headermin to headermax do
header[i] := mem[xword1 : xword2 + i];
if header[5] and $80 = $00 then
write(' ', header[10] : 5)
else begin
for i := 10 to headermax do
write(showchar(chr(header[i])));
write(' ')
end;
write(' ');
segofs1(xword1, xword2);
write(' ', bin16(cbw(header[4], header[5])), ' ');
segofs1(xword1, cbw(header[6], header[7]));
write(' ');
segofs2(xword1, cbw(header[8], header[9]));
xword1 := cbw(header[2], header[3]);
xword2 := cbw(header[0], header[1])
end
end;
(****************************************************************************)
procedure page_13;
var
i : $00..$2B;
xbyte : byte;
xchar : 'A'..'Z';
xFCB : array[$00..$2B] of byte;
xlong : longint;
xstring : string;
xword1 : word;
xword2 : word;
y : byte;
begin
y := wherey + hi(windmin);
window(1, y, twidth div 2, tlength - 2);
if osminor >= 10 then begin
caption2('LASTDRIVE');
drvname(mem[devseg : devofs + $0021] - 1);
writeln
end;
caption2('Diskette drives');
if equip and $0001 = $0001 then
writeln(1 + equip and $00C0 shr 6)
else
writeln(0);
xword1 := longint(intvec[$1E]) shr 16;
xword2 := longint(intvec[$1E]) and $0000FFFF;
caption3('Sectors/track');
writeln(mem[xword1 : xword2 + 4]);
caption3('Bytes/sector');
writeln(mem[xword1 : xword2 + 3] shl 8);
caption3('On time (ms)');
writeln(125 * mem[xword1 : xword2 + 10]);
caption3('Off time (s)');
writeln(longint(mem[xword1 : xword2 + 2]) shl 16 / tick1 : 0 : 1);
caption3('Head settle time (ms)');
writeln(mem[xword1 : xword2 + 9]);
caption1(' Single drive is now ');
xbyte := mem[BIOSdseg : $0104];
if xbyte <= ord('Z') - ord('A') then begin
drvname(xbyte);
writeln
end else if xbyte = $FF then
writeln('N/A')
else
unknown('status', xbyte, 2);
(* Byte 12:12 p.178 *)
writeln;
caption1('Drive Removable');
if osminor >= 10 then begin
caption1(' Remote');
if osminor >= 20 then
caption1(' Alias')
end;
writeln;
window(wherex + lo(windmin), wherey + hi(windmin), twidth, tlength - 2);
with regs do begin
for xchar := 'A' to 'Z' do begin
AH := $0E;
DL := ord(xchar) - ord('A');
MSDOS(regs);
AH := $19;
MSDOS(regs);
if AL = DL then begin
pause1;
drvname(AL);
write(' ');
AX := $4408;
BL := 0;
MSDOS(regs);
if nocarry then
yesorno1(AL = $00)
else
write('? ');
if osminor >= 10 then begin
write(' ');
AX := $4409;
BL := 0;
MSDOS(regs);
if nocarry then
yesorno1(DH and $10 = $10)
else
write('? ');
if osminor >= 20 then begin
write(' ');
AX := $440E;
BL := 0;
MSDOS(regs);
if nocarry then
if AL = $00 then
write('(none)')
else
drvname(AL - 1)
else
write('?')
end
end;
writeln
end
end;
AH := $0E;
DL := currdrv;
MSDOS(regs)
end;
window(1 + twidth div 2, y, twidth, tlength - 2);
caption2('Current drive and path');
getdir(0, xstring);
writeln(xstring);
caption3('Volume label');
for i := $00 to $2B do
xFCB[i] := $00;
xFCB[$00] := $FF; (* extended FCB *)
xFCB[$06] := $08; (* volume ID attribute *)
for i := $08 to $12 do
xFCB[i] := ord('?');
with regs do begin
AH := $11;
DS := seg(xFCB);
DX := ofs(xFCB);
MSDOS(regs);
case AL of
$00 : begin
AH := $2F;
MSDOS(regs);
i := $08;
xchar := char(mem[ES : BX + i]);
while (i <= $12) and (xchar > #0) do begin
write(showchar(xchar));
inc(i);
xchar := char(mem[ES : BX + i])
end;
writeln
end;
$FF : writeln('(none)')
else
unknown('status', AL, 2)
end;
AH := $1B;
MSDOS(regs);
media(mem[DS : BX]);
caption3('Clusters');
writeln(DX);
caption3('Sectors/cluster');
writeln(AL);
caption3('Bytes/sector');
writeln(CX)
end;
caption3('Total space (bytes)');
xlong := disksize(0);
if xlong <> -1 then
writeln(xlong : 8)
else
dontknow2;
caption3('Free space (bytes) ');
xlong := diskfree(0);
if xlong <> -1 then
writeln(xlong : 8)
else
dontknow2
end;
(****************************************************************************)
procedure page_14;
var
i : byte;
xbool : boolean;
xbyte1 : byte;
xbyte2 : byte;
y : byte;
begin
caption2('BIOS disk parameters');
xbool := true;
for i := $00 to $FF do
with regs do begin
AH := $08;
DL := i;
intr($13, regs);
if nocarry and ((BL > $00) or (i >= $80)) then
begin
if xbool then begin
xbool := false;
writeln;
y := wherey + hi(windmin);
caption3('Unit');
writeln;
caption3('Type');
writeln;
caption3('Drives');
writeln;
caption3('Heads');
writeln;
caption3('Cylinders');
writeln;
caption3('Sectors/track');
writeln;
caption3('Specify bytes');
writeln;
caption3('Off time (s)');
writeln;
caption3('Bytes/sector');
writeln;
caption3('Sectors/track');
writeln;
caption3('Gap length');
writeln;
caption3('Data length');
writeln;
caption3('Gap length for format');
writeln;
caption3('Fill byte for format');
writeln;
caption3('Head settle time (ms)');
writeln;
caption3('On time (ms)');
writeln;
xbyte1 := 27
end;
if xbyte1 + 10 > twidth then begin
pause2;
xbyte1 := 27;
window(xbyte1, y, twidth, tlength - 2);
clrscr
end;
window(xbyte1, y, xbyte1 + 11, tlength - 2);
writeln(i);
if i < $80 then
case BL of
$01 : writeln('360KB 5¼"');
$02 : writeln('1.2MB 5¼"');
$03 : writeln('720KB 3½"');
$04 : writeln('1.44MB 3½"')
else
writeln('(', hex(BL, 2), ')')
end
else
writeln('fixed disk');
writeln(DL);
writeln(DH + 1);
writeln(cbw(CH, CL shr 6) + 1);
writeln(CL and $3F);
if i < $80 then begin
writeln('$', hex(mem[ES : DI], 2), ' $'
, hex(mem[ES : DI + $0001], 2));
writeln(longint(mem[ES : DI + $0002]) shl 16 / tick1 : 0
: 1);
xbyte2 := mem[ES : DI + $0003];
case xbyte2 of
$00 : writeln('128');
$01 : writeln('256');
$02 : writeln('512');
$03 : writeln('1024')
else
writeln('(', hex(xbyte2, 4), ')')
end;
writeln(mem[ES : DI + $0004]);
writeln(mem[ES : DI + $0005]);
writeln(mem[ES : DI + $0006]);
writeln(mem[ES : DI + $0007]);
writeln('$', hex(mem[ES : DI + $0008], 2));
writeln(mem[ES : DI + $0009]);
writeln(125 * mem[ES : DI + $000A])
end;
inc(xbyte1, 13)
end
end;
if xbool then
writeln('(no disks)')
end;
(****************************************************************************)
procedure page_15;
var
i : byte;
j : 0..3;
k : byte;
part : array[$00..secsiz - 1] of byte;
xbool1 : boolean;
xbool2 : boolean;
xbyte1 : byte;
xbyte2 : byte;
xlong : longint;
xword : word;
y : byte;
function getpart(a : byte) : boolean;
var
parmblk : array[$00..$25] of byte;
begin
with regs do begin
AX := $440D;
BL := a;
CX := $0860;
DS := seg(parmblk);
DX := ofs(parmblk);
parmblk[$00] := $04;
MSDOS(regs);
if nocarry and (parmblk[$01] = 5) then begin
AX := $440D;
BL := a;
CX := $0861;
DS := seg(parmblk);
DX := ofs(parmblk);
fillchar(parmblk, sizeof(parmblk), $00);
parmblk[$00] := $04;
parmblk[$08] := $01;
parmblk[$09] := lo(ofs(part));
parmblk[$0A] := hi(ofs(part));
parmblk[$0B] := lo(seg(part));
parmblk[$0C] := hi(seg(part));
MSDOS(regs);
getpart := nocarry
end else
getpart := false
end
end;
begin (* procedure page_15 *)
caption2('Partition tables');
if osminor >= 20 then begin
i := 1;
xbool1 := false;
repeat
if getpart(i) then
xbool1 := true
else
inc(i)
until xbool1 or (i > 26);
if xbool1 then begin
writeln;
y := wherey + hi(windmin);
caption3('Drive');
writeln;
caption3('Partition');
writeln;
caption3('Type');
writeln;
caption3('Bootable');
writeln;
caption3('Starting cylinder');
writeln;
caption3('Starting head');
writeln;
caption3('Starting sector');
writeln;
caption3('Ending cylinder');
writeln;
caption3('Ending head');
writeln;
caption3('Ending sector');
writeln;
caption3('First partition sector');
writeln;
caption3('Sectors in partition');
writeln;
repeat
window(10, y, twidth, tlength - 2);
drvname(i - 1);
window(27, y + 1, twidth, tlength - 2);
clrscr;
for j := 0 to 3 do begin
window(27 + 14 * j, y + 1, 38 + 14 * j, tlength - 2);
writeln(j + 1);
xword := $01BE + j shl 4;
xbyte1 := part[xword + 4];
case xbyte1 of
$00 : writeln('not used');
$01 : writeln('DOS-12');
$04 : writeln('DOS-16');
$05 : writeln('Ext DOS');
$06 : writeln('"Huge" DOS')
else
writeln('(', hex(xbyte1, 2), ')')
end;
if xbyte1 > $00 then begin
xbyte2 := part[xword];
case xbyte2 of
$00 : writeln('no');
$80 : writeln('yes')
else
writeln('(', hex(xbyte2, 2), ')')
end;
writeln(cbw(part[xword + 3], part[xword + 2] shr 6));
writeln(part[xword + 1]);
writeln(part[xword + 2] and $3F);
writeln(cbw(part[xword + 7], part[xword + 6] shr 6));
writeln(part[xword + 5]);
writeln(part[xword + 6] and $3F);
xlong := 0;
for k := 11 downto 8 do
xlong := xlong shl 8 + part[xword + k];
writeln(xlong);
xlong := 0;
for k := 15 downto 12 do
xlong := xlong shl 8 + part[xword + k];
writeln(xlong)
end else
for k := 2 to 10 do
writeln('-')
end;
repeat
inc(i);
xbool2 := getpart(i)
until xbool2 or (i > 26);
if xbool2 then
pause2
until i > 26
end else
writeln('(no fixed disks)')
end else
writeln('(not available under this DOS version)')
end;
(****************************************************************************)
procedure page_16;
var
bootrec : array[0..secsiz - 1] of byte;
i : 1..26;
j : word;
xbool : boolean;
xbyte : byte;
xchar : char;
xword1 : word;
xword2 : word;
xword3 : word;
xword4 : word;
xword5 : word;
y : byte;
begin
y := wherey + hi(windmin);
window(1, y, twidth div 2, tlength - 2);
caption1('Boot record');
writeln;
xword1 := diskread(currdrv, 0, 1, bootrec);
if xword1 = $0000 then begin
caption3('Drive');
drvname(currdrv);
writeln;
media(bootrec[$15]);
caption3('Sectors/cluster');
writeln(bootrec[$0D]);
caption3('Bytes/sector');
writeln(cbw(bootrec[$0B], bootrec[$0C]));
caption3('Reserved sectors');
writeln(cbw(bootrec[$0E], bootrec[$0F]));
caption3('FAT''s');
writeln(bootrec[$10]);
caption3('Sectors/FAT');
writeln(cbw(bootrec[$16], bootrec[$17]));
caption3('Root directory entries');
writeln(cbw(bootrec[$11], bootrec[$12]));
writeln;
caption3('Heads');
writeln(cbw(bootrec[$1A], bootrec[$1B]));
caption3('Total sectors');
writeln(cbw(bootrec[$13], bootrec[$14]));
caption3('Sectors/track');
writeln(cbw(bootrec[$18], bootrec[$17]));
caption3('Hidden sectors');
writeln(cbw(bootrec[$1C], bootrec[$1D]));
caption3('OEM name and version');
for i := $03 to $0A do
write(showchar(chr(bootrec[i])));
writeln
end else begin
writeln(' Can''t read boot record');
write(' ');
xbyte := hi(xword1);
case xbyte of
$80 : writeln('Attachment failed to respond');
$40 : writeln('Seek operation failed');
$20 : writeln('Controller failed');
$10 : writeln('Data error (bad CRC)');
$08 : writeln('DMA failure');
$04 : writeln('Sector not found');
$03 : writeln('Write-protect fault');
$02 : writeln('Bad address mark');
$01 : writeln('Bad command');
$00 : writeln
else
unknown('error', xbyte, 2)
end;
write(' ');
xbyte := lo(xword1);
case xbyte of
$00 : writeln('Write-protect error');
$01 : writeln('Unknown unit');
$02 : writeln('Drive not ready');
$03 : writeln('Unknown command');
$04 : writeln('Data error (bad CRC)');
$05 : writeln('Bad request structure length');
$06 : writeln('Seek error');
$07 : writeln('Unknown media type');
$08 : writeln('Sector not found');
$09 : writeln('Printer out of paper');
$0A : writeln('Write fault');
$0B : writeln('Read fault');
$0C : writeln('General failure')
else
unknown('error', xbyte, 2)
end
end;
window(1 + twidth div 2, y, twidth, tlength - 2);
caption1('DOS disk parameters');
writeln;
if osminor >= 10 then begin
i := 1;
xbool := false;
xword1 := memw[devseg : devofs + $0018];
xword2 := memw[devseg : devofs + $0016];
repeat
window(1 + twidth div 2, y + 1, twidth, tlength - 2);
caption3('Drive');
drvname(i - 1);
writeln;
xword3 := memw[xword1 : xword2 + $0047];
xword4 := memw[xword1 : xword2 + $0045];
media(mem[xword3 : xword4 + $0016]);
caption3('Sectors/cluster');
writeln(mem[xword3 : xword4 + $0004] + 1);
caption3('Bytes/sector');
writeln(memw[xword3 : xword4 + $0002]);
caption3('Reserved sectors');
writeln(memw[xword3 : xword4 + $0006]);
caption3('FAT''s');
writeln(mem[xword3 : xword4 + $0008]);
caption3('Sectors/FAT');
writeln(mem[xword3 : xword4 + $000F]);
caption3('Root directory entries');
writeln(memw[xword3 : xword4 + $0009]);
writeln;
caption3('DPB valid');
yesorno2(mem[xword3 : xword4 + $0017] < $FF);
caption3('Current directory');
j := xword2;
xchar := chr(mem[xword1 : j]);
while xchar > #0 do begin
write(xchar);
inc(j);
xchar := chr(mem[xword1 : j])
end;
writeln;
caption3('Device header');
segofs2(memw[xword3 : xword4 + $0014]
, memw[xword3 : xword4 + $0012]);
caption3('Unit within driver');
writeln(mem[xword3 : xword4 + $0001]);
caption3('Clusters');
writeln(memw[xword3 : xword4 + $000D] - 1);
caption3('Cluster to sector shift');
writeln(mem[xword3 : xword4 + $0005]);
caption3('Root directory sector');
writeln(memw[xword3 : xword4 + $0010]);
caption3('First data sector');
writeln(memw[xword3 : xword4 + $000B]);
caption3('Next DPB');
xword5 := memw[xword3 : xword4 + $0018];
segofs2(memw[xword3 : xword4 + $001A], xword5);
if xword5 < $FFFF then begin
write(' ');
pause2;
clrscr;
inc(i);
inc(xword2, $51)
end else
xbool := true
until xbool
end else
writeln('(not available under this DOS version)')
end;